library(tidyverse)
-- Attaching packages -------------------------------------------------------------------------------------------------------------------- tidyverse 1.3.0 --
v tibble 3.1.0 v stringr 1.4.0
v readr 1.4.0 v forcats 0.5.1
-- Conflicts ----------------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
x purrr::%||%() masks flexclust.golem::%||%()
x purrr::accumulate() masks foreach::accumulate()
x dplyr::filter() masks stats::filter()
x purrr::is_null() masks testthat::is_null()
x dplyr::lag() masks stats::lag()
x tidyr::matches() masks dplyr::matches(), testthat::matches()
x MASS::select() masks dplyr::select()
x purrr::when() masks foreach::when()
library(flexclust)
library(flexclust.golem)
params$solutions
flexclust.golem::plot_profile(params$solutions,1)
plot_profile...
class solutions:tbl_dftbldata.frame
class solutions$fit_km:list
class solutions$fit_km[1]:list
class solutions$fit_km[1][[1]]:kcca
i = 1
NULL

i=1
this_solution = params$solutions$fit_km[i][[1]]
k <- this_solution@k
seed = params$solutions$seed[i]
pop_av_dist <- with(this_solution@clusinfo, sum(size*av_dist)/sum(size))
main_txt <- paste("kcca ", "Av Dist = ", format(pop_av_dist, digits = 5), params$method, " - ",k,"seed=",seed)
label_clust <- hclust(dist(t(as.matrix(data_df))))
barchart(this_solution,
which=label_clust$order,
main = main_txt, strip.prefix = "#",
scales = list(cex = 0.6),
shade = TRUE,
legend = TRUE,
clusters=5:6
)
NULL

this_solution
kcca object of family ‘ejaccard’
call:
flexclust::stepFlexclust(x = as.matrix(data_df), k = 6L, nrep = km_nrep, FUN = flexclust::kcca, seed = seed, multicore = FALSE,
family = flexclust::kccaFamily(method))
cluster sizes:
1 2 3 4 5 6
362 434 92 343 227 542
var_labels
[1] "cash_1" "platform_unknown" "shop_before_covid_1"
[4] "person_marital_status_unknown" "tenure_group_0_1" "site_type_shop"
[7] "enroll_site_type_shop" "weekend_1" "age_group_30_40"
[10] "tenure_group_5_10" "site_type_migration" "enroll_site_type_migration"
[13] "age_group_40_50" "tenure_group_3_5" "discount_3_20_percent_30_percent"
[16] "annual_spend_3_2mn_3mn" "discount_4_30_percent_40_percent" "age_group_12_20"
[19] "person_gender_m" "annual_spend_4_3mn_5mn" "tenure_group_10_20"
[22] "age_group_50_60" "pay_with_points_4_more_than_124_points" "annual_spend_5_5mn_10mn"
[25] "discount_5_40_percent_50_percent" "site_type_mobile_apps" "enroll_site_type_mobile_apps"
[28] "platform_i_phone_os" "pay_with_points_2_31_59_points" "bazar_before_covid_1"
[31] "bazar_1" "traveller_1" "discount_6_above_50_percent"
[34] "age_group_unknown" "site_type_online" "enroll_site_type_online"
[37] "site_type_test_market" "enroll_site_type_test_market" "petition_1"
[40] "annual_spend_6_above_10mn" "reach_tbs_voice_1" "bazar_after_covid_1"
[43] "age_group_60_100" "others_1" "reach_tbs_webchat_1"
[46] "posted_reviews_1" "annual_spend_unknown" "pay_with_points_unknown"
[49] "discount_unknown" "reach_tbs_wa_1" "pay_with_points_3_60_124_points"
[52] "abandon_basket_1" "online_before_covid_1" "credit_1"
[55] "bbob_1" "point_redeemer_1" "tenure_group_1_3"
[58] "discount_2_10_percent_20_percent" "annual_spend_2_1mn_2mn" "donation_1"
[61] "sustainability_score_1" "debit_1" "shop_after_covid_1"
[64] "person_marital_status_single" "online_after_covid_1" "working_1"
[67] "age_group_20_30"
plot_data %>%
ggplot() +
geom_point(aes(x=variable, y=all),col="black") +
geom_segment(aes(x=variable, y=0, xend=variable, yend=all),col="black") +
geom_col(aes(x=variable, y=solution, fill=I(shade)),alpha=0.5) +
coord_flip() +
facet_wrap(~segment) +
ylab("Proportion of Segment")


ggplot(data=plot_data %>% filter(part == "all", segment=="1"), aes(x=variable,y=value)) +
geom_col() +
geom_point(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=value)) +
geom_segment(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=0, xend=variable, yend=value)) +
facet_wrap(~segment) + coord_flip()

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShmbGV4Y2x1c3QpDQpsaWJyYXJ5KGZsZXhjbHVzdC5nb2xlbSkNCmBgYA0KDQpgYGB7cn0NCnBhcmFtcyRkYXRhDQpgYGANCg0KYGBge3J9DQpwYXJhbXMkc29sdXRpb25zDQpgYGANCg0KYGBge3IgaGVpZ2h0PTIwLHdpZHRoPTYwfQ0KZmxleGNsdXN0LmdvbGVtOjpwbG90X3Byb2ZpbGUocGFyYW1zJHNvbHV0aW9ucywxKQ0KYGBgDQpgYGB7cn0NCiAgaT0xDQogIHRoaXNfc29sdXRpb24gPSBwYXJhbXMkc29sdXRpb25zJGZpdF9rbVtpXVtbMV1dDQogIGsgPC0gdGhpc19zb2x1dGlvbkBrDQogIHNlZWQgPSBwYXJhbXMkc29sdXRpb25zJHNlZWRbaV0NCiAgcG9wX2F2X2Rpc3QgPC0gd2l0aCh0aGlzX3NvbHV0aW9uQGNsdXNpbmZvLCBzdW0oc2l6ZSphdl9kaXN0KS9zdW0oc2l6ZSkpDQogIG1haW5fdHh0IDwtIHBhc3RlKCJrY2NhICIsICJBdiBEaXN0ID0gIiwgZm9ybWF0KHBvcF9hdl9kaXN0LCBkaWdpdHMgPSA1KSwgcGFyYW1zJG1ldGhvZCwgIiAtICIsaywic2VlZD0iLHNlZWQpDQogIA0KICBsYWJlbF9jbHVzdCA8LSBoY2x1c3QoZGlzdCh0KGFzLm1hdHJpeChkYXRhX2RmKSkpKQ0KICANCiAgYmFyY2hhcnQodGhpc19zb2x1dGlvbiwgDQogICAgICAgICAgIHdoaWNoPWxhYmVsX2NsdXN0JG9yZGVyLA0KICAgICAgICAgICBtYWluID0gbWFpbl90eHQsIHN0cmlwLnByZWZpeCA9ICIjIiwNCiAgICAgICAgICAgc2NhbGVzID0gbGlzdChjZXggPSAwLjYpLA0KICAgICAgICAgICBzaGFkZSA9IFRSVUUsDQogICAgICAgICAgIGxlZ2VuZCA9IFRSVUUsDQogICAgICAgICAgIGNsdXN0ZXJzPTU6Ng0KICApDQpgYGANCmBgYHtyfQ0KY2x1c3Rlcl9kYXRhX2JhbGFuY2VkICU+JSBqYW5pdG9yOjpjbGVhbl9uYW1lcygpIC0+IGNsdXN0ZXJfZGF0YV9iYWxhbmNlZA0KYGBgDQoNCg0KYGBge3J9DQpsYWJlbF9vcmRlciA9IGhjbHVzdChkaXN0KHQoYXMubWF0cml4KGNsdXN0ZXJfZGF0YV9iYWxhbmNlZCkpKSkNCmxhYmVsX29yZGVyJG9yZGVyDQpsZW5ndGgobGFiZWxfb3JkZXIkb3JkZXIpDQp2YXJfbGFiZWxzID0gY29sbmFtZXMoY2x1c3Rlcl9kYXRhX2JhbGFuY2VkKVtsYWJlbF9vcmRlciRvcmRlcl0NCmxlbmd0aCh2YXJfbGFiZWxzKQ0KdmFyX2xhYmVscw0KYGBgDQoNCmBgYHtyfQ0KYmluZF9yb3dzKA0KICB0aGlzX3NvbHV0aW9uQHhjZW50ICU+JSBhc190aWJibGVfcm93KCkgJT4lIGphbml0b3I6OmNsZWFuX25hbWVzKCkgJT4lIHNsaWNlKHJlcCgxOm4oKSwgZWFjaD02KSkgJT4lIGFkZF9jb2x1bW4oc2VnbWVudCA9IDE6NiwgcGFydD0iYWxsIikgICwNCiAgdGhpc19zb2x1dGlvbkBjZW50ZXJzICU+JSBhc190aWJibGUoKSAlPiUgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKSAlPiUgYWRkX2NvbHVtbihzZWdtZW50PSAxOjYsIHBhcnQ9InNvbHV0aW9uIikNCikgJT4lIA0KICBwaXZvdF9sb25nZXIoY29scz0xOjY3LCBuYW1lc190bz0idmFyaWFibGUiLCB2YWx1ZXNfdG8gPSAidmFsdWUiKSAlPiUgDQogIHBpdm90X3dpZGVyKGlkX2NvbHMgPSBjKHZhcmlhYmxlLHNlZ21lbnQscGFydCksIG5hbWVzX2Zyb20gPSBwYXJ0LCB2YWx1ZXNfZnJvbT12YWx1ZSkgJT4lIA0KICBtdXRhdGUoDQogICAgdmFyX2xhYmVsID0gZmFjdG9yKHZhcmlhYmxlLCBsZXZlbHM9dmFyX2xhYmVscyksDQogICAgZGlmZiA9IGFsbCAtIHNvbHV0aW9uLA0KICAgIGFic19kaWZmID0gYWJzKGRpZmYpLA0KICAgIGFic19wcm9wX2RpZmYgPSBhYnMoZGlmZi9hbGwpLA0KICAgIHNpZ25pZiA9IGlmX2Vsc2UoYWJzX2RpZmYgPiAwLjUgfCBhYnNfcHJvcF9kaWZmID4gMC4yNSwgVFJVRSwgRkFMU0UpLA0KICAgIHNoYWRlID0gbWFwMl9jaHIoc2lnbmlmLCBzZWdtZW50LH5mbGV4Y2x1c3Q6OmZseENvbG9ycyhuPS55LCBncmV5PSEueCkpDQogICAgKSAtPiBwbG90X2RhdGENCnBsb3RfZGF0YSAlPiUgVmlldygpDQpgYGANCg0KYGBge3IgZmlnLmhlaWdodD0xMH0NCnBsb3RfZGF0YSAlPiUgDQogIGdncGxvdCgpICsNCiAgZ2VvbV9wb2ludChhZXMoeD12YXJpYWJsZSwgeT1hbGwpLGNvbD0iYmxhY2siKSArDQogIGdlb21fc2VnbWVudChhZXMoeD12YXJpYWJsZSwgeT0wLCB4ZW5kPXZhcmlhYmxlLCB5ZW5kPWFsbCksY29sPSJibGFjayIpICsNCiAgZ2VvbV9jb2woYWVzKHg9dmFyaWFibGUsIHk9c29sdXRpb24sIGZpbGw9SShzaGFkZSkpLGFscGhhPTAuNSkgKw0KICBjb29yZF9mbGlwKCkgKw0KICBmYWNldF93cmFwKH5zZWdtZW50KSArDQogIHlsYWIoIlByb3BvcnRpb24gb2YgU2VnbWVudCIpIA0KDQpgYGANCg0KYGBge3J9DQpwbG90X2RhdGEgJT4lIA0KICBmaWx0ZXIoc3RyX3N0YXJ0cyh2YXJpYWJsZSwiYWdlIikpICU+JSANCiAgZ2dwbG90KCkgKw0KICBnZW9tX3BvaW50KGFlcyh4PXZhcmlhYmxlLCB5PWFsbCksY29sPSJibGFjayIpICsNCiAgZ2VvbV9zZWdtZW50KGFlcyh4PXZhcmlhYmxlLCB5PTAsIHhlbmQ9dmFyaWFibGUsIHllbmQ9YWxsKSxjb2w9ImJsYWNrIikgKw0KICBnZW9tX2NvbChhZXMoeD12YXJpYWJsZSwgeT1zb2x1dGlvbiwgZmlsbD1JKHNoYWRlKSksYWxwaGE9MC41KSArDQogIGNvb3JkX2ZsaXAoKSArDQogIGZhY2V0X3dyYXAofnNlZ21lbnQpICsNCiAgeWxhYigiUHJvcG9ydGlvbiBvZiBTZWdtZW50IikgDQoNCmBgYA0KDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGE9cGxvdF9kYXRhICU+JSBmaWx0ZXIocGFydCA9PSAiYWxsIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUseT12YWx1ZSkpICsgDQogIGdlb21fY29sKCkgKyANCiAgZ2VvbV9wb2ludChkYXRhPXBsb3RfZGF0YSAlPiUgZmlsdGVyKHBhcnQgPT0gInNvbHV0aW9uIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUsIHk9dmFsdWUpKSArDQogIGdlb21fc2VnbWVudChkYXRhPXBsb3RfZGF0YSAlPiUgZmlsdGVyKHBhcnQgPT0gInNvbHV0aW9uIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUsIHk9MCwgeGVuZD12YXJpYWJsZSwgeWVuZD12YWx1ZSkpICsNCiAgZmFjZXRfd3JhcCh+c2VnbWVudCkgKyBjb29yZF9mbGlwKCkNCmBgYA0KDQoNCmBgYHtyfQ0KYmFyY2hhcnQodGhpc19zb2x1dGlvbiwgDQogICAgICAgICB3aGljaD0iYWdlX2dyb3VwXygxMiwyMF0iLA0KICAgICAgICAgbWFpbiA9IG1haW5fdHh0LCBzdHJpcC5wcmVmaXggPSAiIyIsDQogICAgICAgICBzY2FsZXMgPSBsaXN0KGNleCA9IDAuNiksDQogICAgICAgICBzaGFkZSA9IFRSVUUsDQogICAgICAgICBsZWdlbmQgPSBUUlVFLA0KICAgICAgICAgYnl2YXI9VFJVRQ0KKQ0KYGBgDQoNCg==